home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / programr / iceb3r1.zip / ice.bas < prev    next >
BASIC Source File  |  1995-05-01  |  4KB  |  128 lines
  1. ' ---------------------------------------------------------
  2. '       Copyright (C) 1995 Stephen Darlington
  3. '
  4. ' The distrubution of this file is covered by the
  5. ' agreement in the ICE help file.
  6.  
  7. Option Explicit
  8. '
  9. ' ICE function declarations
  10. Declare Function Freeze Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal fuOptions As Long) As Integer
  11. Declare Function Thaw Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal fuOptions As Long) As Integer
  12. Declare Function ListArchive Lib "ice.dll" (ByVal lpMask As String, ByVal lpLZH As String, ByVal lpStr As String) As Integer
  13. Declare Sub InitialiseICE Lib "ice.dll" (ByVal hMain As Integer, ByVal hDisplay As Integer, ByVal fuOptions As Long)
  14. '
  15. ' Constant for Freeze
  16. Global Const ICE_STOREFULLPATHS = &H0&          'default
  17. Global Const ICE_STORERELATIVEPATHS = &H1&
  18. Global Const ICE_STORENOPATHS = &H2&
  19. Global Const ICE_RECURSIVE = &H4&
  20. Global Const ICE_INCLUDEARCHIVEFILES = &H10&
  21. Global Const ICE_INCLUDEREADONLYFILES = &H20&
  22. Global Const ICE_INCLUDESYSTEMFILES = &H40&
  23. Global Const ICE_INCLUDEHIDDENFILES = &H80&
  24. Global Const ICE_INCLUDENORMALFILES = &H100&    'default
  25. Global Const ICE_TURNARCHIVEOFF = &H200&
  26. Global Const ICE_TURNREADONLYOFF = &H400&
  27. Global Const ICE_TURNSYSTEMOFF = &H800&
  28. Global Const ICE_TURNHIDDENOFF = &H1000&
  29. '
  30. ' Constants for Thaw
  31. Global Const ICE_RESTOREDIRECTORIES = &H1&
  32. Global Const ICE_DELETEFILES = &H2&
  33.  
  34. ' Constants for Freeze and Thaw
  35. Global Const ICE_MOVEFILES = &H8&
  36. Global Const ICE_OVERWRITEALL = &H2000&
  37. Global Const ICE_OVERWRITEIFNEWER = &H4000&
  38. Global Const ICE_OVERWRITEQUERY = &H8000&       'default for both
  39. Global Const ICE_OVERWRITENEVER = &H10000
  40.  
  41. ' Constants for InitailiseICE
  42. Global Const ICE_PASSPERCENT = &H1&
  43. Global Const ICE_PASSFILENAME = &H2&
  44.  
  45. ' User-defined type for ListArchiveContents
  46. Type ICEINFO_TYPE
  47.     sPath As String
  48.     sFilename As String
  49.     sDate As String * 8
  50.     sTime As String * 8
  51.     sAttributes As String * 4
  52.     lOriginalSize As Long
  53.     lCompressedSize As Long
  54.     sRatio As String * 3
  55.     sMethod As String * 5
  56.     sCRC As String * 4
  57. End Type
  58.  
  59. Function GetPiece (from As String, delim As String, Index As Integer) As String
  60.     Dim temp$
  61.     Dim Count As Integer
  62.     Dim Where As Integer
  63.     '
  64.     temp$ = from & delim
  65.     Where = InStr(temp$, delim)
  66.     Count = 0
  67.     Do While (Where > 0)
  68.         Count = Count + 1
  69.         If (Count = Index) Then
  70.             GetPiece = Left$(temp$, Where - 1)
  71.             Exit Function
  72.         End If
  73.         temp$ = Right$(temp$, Len(temp$) - Where)
  74.         Where = InStr(temp$, delim)
  75.     Loop
  76.     If (Count = 0) Then
  77.         GetPiece = from
  78.     Else
  79.         GetPiece = ""
  80.     End If
  81. End Function
  82.  
  83. Function ListArchiveContents (sMask As String, sLZH As String, info() As ICEINFO_TYPE)
  84. '
  85. ' VB function wrapper around the ICE function ListArchive
  86. '
  87. ' sMask      - the files to retrieve (e.g. *.DLL or *.DOC)
  88. ' sLZH       - the path and filename of the archive (e.g. C:\TEMP\ICE.LZH)
  89. ' info()     - an array of type ICEINFO_TYPE provided by the user
  90. '
  91. ' This function returns the number of files retrieved into the
  92. ' users array if the function is successful. If the function is
  93. ' not successful, a (negative) error code is returned.
  94. '
  95.     Dim all$, sTemp$
  96.     Dim I As Integer
  97.     Dim iCount As Integer
  98.     Dim iCarat As Integer
  99.     '
  100.     all$ = String(60000, " ")
  101.     iCount = ListArchive(sMask, sLZH, all$)
  102.     If (iCount <= 0) Then
  103.         all$ = ""
  104.         ListArchiveContents = iCount
  105.         End
  106.     End If
  107.     all$ = Left$(all$, InStr(all$, Chr$(0)) - 1)
  108.     ReDim info(iCount)
  109.     For I = 1 To iCount Step 1
  110.         iCarat = InStr(all$, "^")
  111.         sTemp$ = Left$(all$, iCarat - 1)
  112.         info(I).sPath = GetPiece(sTemp$, "#", 1)
  113.         info(I).sFilename = GetPiece(sTemp$, "#", 2)
  114.         info(I).sDate = GetPiece(sTemp$, "#", 3)
  115.         info(I).sTime = GetPiece(sTemp$, "#", 4)
  116.         info(I).sAttributes = GetPiece(sTemp$, "#", 5)
  117.         info(I).lOriginalSize = Val(GetPiece(sTemp$, "#", 6))
  118.         info(I).lCompressedSize = Val(GetPiece(sTemp$, "#", 7))
  119.         info(I).sRatio = GetPiece(sTemp$, "#", 8)
  120.         info(I).sMethod = GetPiece(sTemp$, "#", 9)
  121.         info(I).sCRC = GetPiece(sTemp$, "#", 10)
  122.         all$ = Right$(all$, (Len(all$) - iCarat))
  123.     Next I
  124.     all$ = ""
  125.     ListArchiveContents = iCount
  126. End Function
  127.  
  128.